home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
qb4inp.arc
/
QB4INPUT.BAS
Wrap
BASIC Source File
|
1987-11-24
|
13KB
|
437 lines
' (c) 1987 by Paul M. Friedman
' placed in the Public Domain
' requires QucikBasic 4.0
CONST false = 0, true = NOT false
DECLARE SUB Border (title AS STRING)
DECLARE SUB GoodFile (y%, x%, filename$, ok%)
DECLARE FUNCTION FileExists% (filename$)
DECLARE FUNCTION OneChr$ (y%, x%, GoodList$)
DECLARE FUNCTION NoShow$ (GoodList$)
DECLARE FUNCTION OneInt% (y%, x%, mn%, mx%)
DECLARE FUNCTION IntIn% (y%, x%, mn%, mx%, length%)
DECLARE FUNCTION Int2% (y%, x%, mn%, mx%)
DECLARE FUNCTION LongIn& (y%, x%, mn&, mx&, length%)
DECLARE FUNCTION WholeIn! (y%, x%, mn!, mx!, length%)
DECLARE FUNCTION StrIn$ (y%, x%, length%)
DECLARE FUNCTION BlankIn$ (y%, x%, length%)
DECLARE FUNCTION YesNo% (y%, x%)
DECLARE FUNCTION Point2In (y%, x%, mn!, mx!, length%)
DECLARE FUNCTION OnePt2! (y%, x%, mn!, mx!)
' Input Routines using QuickBasic 4.0 FUNCTIONS
' y% & x% are used as LOCATE y%, x%
' Border [SUBROUTINE, not Function] : displays border & centers optinal
' title [highlited] on top of border
' GoodFile [SUBROUTINE, not Function] : checks a string to be sure
' it is 1-8 characters in length & contains only letters
' and/or numbers
' FileExists returns true (-1) if file exists; false(0) otherwise
' OneChr$: accepts a string of LEN=1; checks to see if it is contained
' is GoodList$ [after capitalizing the input], beeps until
' a valid input is made. no <enter> key
' NoShow$: as OneChr$, but no prompt { ■ } nor is input echoed to screen
' OneInt%: accepts a single digit. checks to see if it is >=mn% and
' <= mx. no <enter> key
' IntIn%: accepts integer input of length% length; must be >=mn% & <=mx%
' Positive ##'s only.
' Int2%: 2 digit input. must use 02 for 2, etc. no <enter> key
' LongIn&: as IntIn% but for LONG Integers
' WholeIn!: as IntIn% but for SINGLES.
' StrIn$: accepts string input of LEN=(1 to length%)
' BlankIn$: accepts string input of LEN=0 to length%)
' YesNo$: accepts Y or N [forces caps]. return true if Y, false if N
' echoes "Yes" or "No" to screen
' Point2In!: accepts input of real number of max whole number length of
' of length% plus optional decimal point and 1 or 2 digits following
' OnePt2!: Whole number + 2 decimal places. forced, no <enter> key
' Note that IntIn, LongIn, WholeIn, Point2In format output.
FUNCTION BlankIn$ (y%, x%, length%)
COLOR 11, 0
LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
temp$ = ""
DO
t$ = INPUT$(1)
IF t$ = CHR$(13) THEN
PRINT SPACE$(length% - LEN(temp$));
COLOR 3, 0: EXIT DO
ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
temp$ = LEFT$(temp$, LEN(temp$) - 1)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF LEN(temp$) = length% THEN
BEEP
ELSEIF t$ < " " OR t$ > "~" THEN
BEEP
ELSE
temp$ = temp$ + t$
PRINT t$;
END IF
LOOP
BlankIn$ = temp$
END FUNCTION
SUB Border (title AS STRING)
CLS
COLOR 3, 0
LOCATE 3, 5: PRINT CHR$(201); STRING$(69, 205); CHR$(187);
FOR i% = 4 TO 22
LOCATE i%, 5: PRINT CHR$(186); : LOCATE , 75: PRINT CHR$(186);
NEXT
LOCATE 23, 5: PRINT CHR$(200); STRING$(69, 205); CHR$(188);
IF title$ <> "" THEN
COLOR 11, 0
LOCATE 3, 40 - LEN(title$) \ 2: PRINT title$;
END IF
COLOR 3, 0
END SUB
FUNCTION FileExists% (filename$)
filenum = FREEFILE
OPEN filename$ FOR RANDOM AS filenum LEN = 1
IF LOF(filenum) = 0 THEN
FileExists% = false
CLOSE filenum
KILL filename$
ELSE
FileExists% = true
CLOSE filenum
END IF
END FUNCTION
SUB GoodFile (y%, x%, filename$, ok%)
filename$ = UCASE$(StrIn$(y%, x%, 8))
FOR i% = 1 TO LEN(filename$)
t$ = MID$(filename$, i%, 1)
IF t$ > "Z" OR t$ < "A" THEN
IF t$ < "0" OR t$ > "9" THEN
BEEP: ok% = false: EXIT SUB
END IF
END IF
NEXT
ok% = true
END SUB
FUNCTION Int2% (y%, x%, mn%, mx%)
temp$ = "": COLOR 11, 0
DO
LOCATE y%, x%: PRINT STRING$(2, 254); STRING$(2, 29);
DO
temp$ = INPUT$(1)
IF temp$ < "0" OR temp$ > "9" THEN
BEEP
ELSEIF VAL(temp$ + "9") < mn% THEN
BEEP
ELSEIF VAL(temp$ + "0") > mx% THEN
BEEP
ELSE
PRINT temp$;
EXIT DO
END IF
LOOP
DO
t$ = INPUT$(1)
IF t$ < "0" OR t$ > "9" THEN
BEEP
ELSEIF VAL(temp$ + t$) < mn% OR VAL(temp$ + t$) > mx% THEN
BEEP
EXIT DO
ELSE
PRINT t$;
Int2% = VAL(temp$ + t$)
COLOR 3, 0
EXIT FUNCTION
END IF
LOOP
LOOP
END FUNCTION
FUNCTION IntIn% (y%, x%, mn%, mx%, length%)
COLOR 11, 0
DO
temp$ = ""
LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
DO
t$ = INPUT$(1)
IF t$ = CHR$(13) AND temp$ <> "" THEN
IF VAL(temp$) < mn% OR VAL(temp$) > mx% THEN
BEEP: EXIT DO
ELSE
PRINT STRING$(length% - LEN(temp$), 32);
frmt$ = STRING$(length%, "#") + ","
LOCATE y%, x%
PRINT USING frmt$; VAL(temp$);
IntIn% = VAL(temp$)
COLOR 3, 0
EXIT FUNCTION
END IF
ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
temp$ = LEFT$(temp$, LEN(temp$) - 1)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF LEN(temp$) = length% THEN
BEEP
ELSEIF t$ < "0" OR t$ > "9" THEN
BEEP
ELSE
temp$ = temp$ + t$: PRINT t$;
END IF
LOOP
LOOP
END FUNCTION
FUNCTION LongIn& (y%, x%, mn&, mx&, length%)
COLOR 11, 0
DO
temp$ = ""
LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
DO
t$ = INPUT$(1)
IF t$ = CHR$(13) AND temp$ <> "" THEN
IF VAL(temp$) < mn& OR VAL(temp$) > mx& THEN
BEEP: EXIT DO
ELSE
PRINT STRING$(length% - LEN(temp$), 32);
frmt$ = STRING$(length%, "#") + STRING$(length% \ 3, ",")
LOCATE y%, x%
PRINT USING frmt$; VAL(temp$);
LongIn& = VAL(temp$)
COLOR 3, 0
EXIT FUNCTION
END IF
ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
temp$ = LEFT$(temp$, LEN(temp$) - 1)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF LEN(temp$) = length% THEN
BEEP
ELSEIF t$ < "0" OR t$ > "9" THEN
BEEP
ELSE
temp$ = temp$ + t$: PRINT t$;
END IF
LOOP
LOOP
END FUNCTION
FUNCTION NoShow$ (GoodList$)
temp$ = " "
WHILE INSTR(GoodList$, temp$) = 0
temp$ = INPUT$(1)
temp$ = UCASE$(temp$)
IF INSTR(GoodList$, temp$) = 0 THEN BEEP
WEND
NoShow$ = temp$
END FUNCTION
FUNCTION OneChr$ (y%, x%, GoodList$)
COLOR 11, 0: LOCATE y%, x%: PRINT CHR$(254); CHR$(29);
temp$ = " "
WHILE INSTR(GoodList$, temp$) = 0
temp$ = INPUT$(1)
temp$ = UCASE$(temp$)
IF INSTR(GoodList$, temp$) = 0 THEN BEEP
WEND
PRINT temp$;
COLOR 3, 0
OneChr$ = temp$
END FUNCTION
FUNCTION OneInt% (y%, x%, mn%, mx%)
COLOR 11, 0: LOCATE y%, x%: PRINT CHR$(254); CHR$(29);
temp$ = ""
WHILE temp$ = "" OR VAL(temp$) < mn% OR VAL(temp$) > mx%
temp$ = INPUT$(1)
IF temp$ < "0" OR temp$ > "9" THEN
BEEP: temp$ = ""
ELSEIF VAL(temp$) < mn% OR VAL(temp$) > mx% THEN
BEEP: temp$ = ""
END IF
PRINT temp$;
OneInt% = VAL(temp$)
COLOR 3, 0
WEND
END FUNCTION
FUNCTION OnePt2 (y%, x%, mn, mx)
COLOR 11, 0
DO
LOCATE y%, x%: PRINT "■.■■";
LOCATE y%, x%: temp$ = ""
DO
t$ = INPUT$(1)
IF t$ < "0" OR t$ > "9" THEN
BEEP
ELSEIF VAL(t$) + .99 < mn OR VAL(t$) > mx THEN
BEEP
ELSE
temp$ = t$ + "."
PRINT t$; "."
LOCATE y%, x% + 2
END IF
LOOP WHILE temp$ = ""
DO WHILE LEN(temp$) = 2
LOCATE y%, x% + 2
t$ = INPUT$(1)
IF t$ = CHR$(8) THEN
EXIT DO
ELSEIF VAL(temp$ + t$) + .09 < mn OR VAL(temp$ + t$) > mx THEN
BEEP
EXIT DO
ELSEIF t$ < "0" OR t$ > "9" THEN
BEEP
ELSE
temp$ = temp$ + t$
PRINT t$;
END IF
LOOP
DO WHILE LEN(temp$) = 3
LOCATE y%, x% + 3
t$ = INPUT$(1)
IF t$ = CHR$(8) THEN
temp$ = LEFT$(temp$, 2)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF t$ < "0" OR t$ > "9" THEN
BEEP
ELSEIF VAL(temp$ + t$) < mn OR VAL(temp$ + t$) > mx THEN
BEEP
EXIT DO
ELSE
temp$ = temp$ + t$
PRINT t$;
OnePt2 = VAL(temp$)
COLOR 3, 0
EXIT FUNCTION
END IF
LOOP
LOOP
END FUNCTION
FUNCTION Point2In (y%, x%, mn, mx, length%)
COLOR 11, 0
DO
LOCATE y%, x%: PRINT STRING$(length% + 3, 254);
LOCATE y%, x%: temp$ = ""
DO
t$ = INPUT$(1)
IF t$ = CHR$(13) AND temp$ <> "" THEN
EXIT DO
ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
temp$ = LEFT$(temp$, LEN(temp$) - 1)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF LEN(temp$) = length% + 3 THEN
BEEP
ELSEIF t$ = "." AND INSTR(temp$, t$) = 0 THEN
temp$ = temp$ + t$: PRINT t$;
ELSEIF t$ < "0" OR t$ > "9" THEN
BEEP
ELSE
temp$ = temp$ + t$
PRINT t$;
END IF
LOOP
IF VAL(temp$) < mn OR VAL(temp$) > mx THEN BEEP ELSE EXIT DO
LOOP
Point2In = VAL(temp$)
LOCATE y%, x%: PRINT STRING$(length% + 3, 32); : LOCATE y%, x%
frmt$ = STRING$(length%, "#") + STRING$(length% \ 3, ",") + ".##"
PRINT USING frmt$; VAL(temp$);
COLOR 3, 0
END FUNCTION
FUNCTION StrIn$ (y%, x%, length%)
COLOR 11, 0
LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
temp$ = ""
DO
t$ = INPUT$(1)
IF t$ = CHR$(13) AND temp$ <> "" THEN
PRINT SPACE$(length% - LEN(temp$));
COLOR 3, 0: EXIT DO
ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
temp$ = LEFT$(temp$, LEN(temp$) - 1)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF LEN(temp$) = length% THEN
BEEP
ELSEIF t$ < " " OR t$ > "~" THEN
BEEP
ELSE
temp$ = temp$ + t$
PRINT t$;
END IF
LOOP
StrIn$ = temp$
END FUNCTION
FUNCTION WholeIn (y%, x%, mn, mx, length%)
COLOR 11, 0
DO
temp$ = ""
LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
DO
t$ = INPUT$(1)
IF t$ = CHR$(13) AND temp$ <> "" THEN
IF VAL(temp$) < mn OR VAL(temp$) > mx THEN
BEEP: EXIT DO
ELSE
PRINT STRING$(length% - LEN(temp$), 32);
frmt$ = STRING$(length%, "#") + STRING$(length% \ 3, ",")
LOCATE y%, x%
PRINT USING frmt$; VAL(temp$);
WholeIn = VAL(temp$)
COLOR 3, 0
EXIT FUNCTION
END IF
ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
temp$ = LEFT$(temp$, LEN(temp$) - 1)
PRINT CHR$(29); CHR$(254); CHR$(29);
ELSEIF LEN(temp$) = length% THEN
BEEP
ELSEIF t$ < "0" OR t$ > "9" THEN
BEEP
ELSE
temp$ = temp$ + t$: PRINT t$;
END IF
LOOP
LOOP
END FUNCTION
FUNCTION YesNo% (y%, x%)
COLOR 11, 0: LOCATE y%, x%: PRINT CHR$(254); CHR$(29);
DO
t$ = UCASE$(INPUT$(1))
IF t$ = "Y" THEN
YesNo% = true
PRINT "Yes";
EXIT DO
ELSEIF t$ = "N" THEN
YesNo% = false
PRINT "No";
EXIT DO
END IF
BEEP
LOOP
COLOR 3, 0
END FUNCTION